Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/vb_g_prt/prtsetup.frm

Visual Basic Form | 1995-09-06 | 9.1 KB | 263 lines

VERSION 2.00
Begin Form PrtSetupForm
   BackColor       =   &H8000000F&
   Caption         =   "Print Setup"
   ClientHeight    =   2235
   ClientLeft      =   1185
   ClientTop       =   2520
   ClientWidth     =   6060
   Height          =   2640
   Left            =   1125
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2235
   ScaleWidth      =   6060
   Top             =   2175
   Width           =   6180
   Begin TextBox txtTempOrientation
      Height          =   372
      Left            =   120
      TabIndex        =   9
      Text            =   "txtTempOrientation"
      Top             =   2520
      Visible         =   0   'False
      Width           =   5172
   End
   Begin TextBox txtTempPrinter
      Height          =   372
      Left            =   120
      TabIndex        =   8
      Text            =   "txtTempPrinter"
      Top             =   2160
      Visible         =   0   'False
      Width           =   5172
   End
   Begin Frame Frame1
      BackColor       =   &H00C0C0C0&
      Caption         =   "Orientation"
      Height          =   1092
      Left            =   4200
      TabIndex        =   5
      Top             =   960
      Width           =   1692
      Begin OptionButton Option1
         BackColor       =   &H00C0C0C0&
         Caption         =   "Landscape"
         Height          =   252
         Index           =   1
         Left            =   120
         TabIndex        =   7
         Top             =   720
         Width           =   1452
      End
      Begin OptionButton Option1
         BackColor       =   &H00C0C0C0&
         Caption         =   "Portrait"
         Height          =   252
         Index           =   0
         Left            =   120
         TabIndex        =   6
         Top             =   360
         Width           =   1452
      End
   End
   Begin ListBox List1
      Height          =   1785
      Left            =   120
      TabIndex        =   4
      Top             =   336
      Width           =   3855
   End
   Begin CommandButton cmdSetup
      Caption         =   "&Setup..."
      Height          =   348
      Left            =   4200
      TabIndex        =   2
      Top             =   1728
      Width           =   1332
   End
   Begin CommandButton cmdCancel
      Cancel          =   -1  'True
      Caption         =   "&Cancel"
      Height          =   348
      Left            =   4200
      TabIndex        =   1
      Top             =   576
      Width           =   1332
   End
   Begin CommandButton cmdOK
      Caption         =   "&OK"
      Default         =   -1  'True
      Height          =   348
      Left            =   4200
      TabIndex        =   0
      Top             =   144
      Width           =   1332
   End
   Begin Label Label1
      BackColor       =   &H8000000F&
      Caption         =   "&Printer:"
      Height          =   204
      Left            =   120
      TabIndex        =   3
      Top             =   96
      Width           =   972
   End
'----------------------------------------------------------------
'Copyright 1994   Unger Business Systems  All Rights Reserved
'This code is distributed as shareware.  If you use it, you
'are required by law to register it.  Please contact Unger
'Business Systems at 11926 Barrett Brae, Houston, TX 77072-4004
'or call [phone].  Registration fee is $20.00 US
'See the README.TXT file for more information
'All code, forms, modules, controls, etc. are provided without
'warranty or liability
'----------------------------------------------------------------
Option Explicit
Dim PrinterArray$(1 To 20)
Dim TempPrtOrientStr$
Sub cmdCancel_Click ()
   txtTempPrinter = ""
   Me.Hide
End Sub
Sub cmdOK_Click ()
   Me.Hide
End Sub
Sub cmdSetup_Click ()
    'can only happen if cmdSetup is made visible
    Dim dev$, devname$, DevOutput$
    Dim dm As DEVMODE, dmout As DEVMODE
    Dim libhnd%
    Dim bufsize%
    Dim dminstring$, dmoutstring$
    Dim dminaddr&, dmoutaddr&, di%
    dev$ = PrinterArray(List1.ItemData(List1.ListIndex))
    If dev$ = "" Then Exit Sub
    devname$ = GetDeviceName$(dev$)
    DevOutput$ = GetDeviceOutput$(dev$)
    ' Load the device driver library - exit if unavailable
    libhnd% = LoadLibrary(GetDeviceDriver$(dev$) & ".drv")
    If libhnd% = 0 Then
       Beep
       MsgBox "Unable to load driver " & GetDeviceDriver(dev) & ".drv", MB_ICONEXCLAMATION
       Exit Sub
    End If
    bufsize% = agExtDeviceMode%(hWnd, libhnd%, 0, devname$, DevOutput$, agGetAddressForObject(dm), 0, 0)
    dminstring$ = String$(bufsize%, 0)
    dmoutstring$ = String$(bufsize%, 0)
   'set orientation to current orientation
    agCopyDataBynum agGetAddressForVBString&(dminstring$), agGetAddressForObject&(dm), 68
    If TempPrtOrientStr = "LANDSCAPE" Then
      dm.dmOrientation = DMORIENT_LANDSCAPE
    Else
      dm.dmOrientation = DMORIENT_PORTRAIT
    End If
    dm.dmFields = dm.dmFields Or DM_ORIENTATION
    agCopyDataBynum agGetAddressForObject&(dm), agGetAddressForVBString&(dminstring$), 68
    dminaddr& = agGetAddressForVBString&(dminstring$)
    dmoutaddr& = agGetAddressForVBString&(dmoutstring$)
    ' The output DEVMODE structure will reflect any changes
    ' made by the printer setup dialog box.
    ' Note that no changes will be made to the default
    ' printer settings
    di% = agExtDeviceMode(hWnd, libhnd%, dmoutaddr&, devname$, DevOutput$, dminaddr&, 0, DM_IN_BUFFER Or DM_IN_PROMPT Or DM_OUT_BUFFER)
    If di = 1 Then 'OK
       ' Copy the data buffer into the DEVMODE structure
       agCopyDataBynum agGetAddressForVBString&(dmoutstring$), agGetAddressForObject&(dmout), 68
       If dmout.dmOrientation = DMORIENT_PORTRAIT Then
          TempPrtOrientStr = "PORTRAIT"
       Else
          TempPrtOrientStr = "LANDSCAPE"
       End If
    End If
cleanup:
   FreeLibrary (libhnd%)
End Sub
Sub Form_Load ()
   Dim PrinterInfo$, I%, IPos%, OldPos%, Counter As Integer, DisplayStr$
   Dim ThisPort$, ThisPrinter$, XtraInfo$, DevOutput$, NumOutputs%
   Dim AddThis$, CurrentPrinter$
   'note that everything here is set up so that it can be encapsulated
   'in the SelectPrinter routine
   CurrentPrinter = GetDeviceName(txtTempPrinter) & " on " & GetDeviceOutput(txtTempPrinter)
   If txtTempOrientation = "PORTRAIT" Then
      Option1(0) = True
   Else
      Option1(1) = True
   End If
   List1.Clear
   PrinterInfo$ = Space$(255)
   'Calling GetProfileString with 0& as the second parameter returns a list
   'of all items in the "devices" section of WIN.INI
   'These are separated by ASCII 0's and must be parsed
   I% = GetProfileString("devices", 0&, "none", PrinterInfo$, Len(PrinterInfo$))
   PrinterInfo$ = Left$(PrinterInfo$, I%)
   If PrinterInfo$ = "none" Then
      MsgBox "No Windows printers installed."
      Exit Sub
   End If
   'MsgBox PrinterInfo
   'parse out printers
   'NOTE:  If a printer is installed for more than one port, it's string
   'will look something like the following:
   '              HP DeskJet 500,HPDSKJET,LPT1:,LPT2:
   'Some of the code below is designed to create two strings,
   'each with only one port
   OldPos% = 1
   Counter = 1
   Do While 1
      IPos% = InStr(OldPos%, PrinterInfo$, Chr$(0))
      If IPos% > 0 Then
         ThisPrinter$ = Mid$(PrinterInfo$, OldPos%, IPos% - OldPos%)
         XtraInfo$ = Space$(255)
         I% = GetProfileString("devices", ThisPrinter$, "none", XtraInfo$, Len(XtraInfo$))
         ThisPrinter$ = ThisPrinter$ & "," & Left$(XtraInfo$, I%)
         If Counter <= 20 Then
            PrinterArray(Counter) = ThisPrinter
         End If
         DevOutput = GetDeviceOutput(ThisPrinter)
         NumOutputs = GetNumDeviceOutputs(DevOutput)
         For I = 1 To NumOutputs
            AddThis = GetDeviceName(ThisPrinter$) & " on " & GetNumberedDeviceOutput(DevOutput, I)
            PrinterArray(Counter) = GetDeviceName(ThisPrinter) & "," & GetDeviceDriver(ThisPrinter) & "," & GetNumberedDeviceOutput(DevOutput, I)
            List1.AddItem AddThis
            List1.ItemData(List1.NewIndex) = Counter
            If PrinterArray(Counter) = CurrentPrinter Then
               List1.ListIndex = Counter - 1
            End If
            Counter = Counter + 1
         Next I
         OldPos% = IPos% + 1
      Else
         Exit Do
      End If
   Loop
   If List1.ListIndex < 0 Then List1.ListIndex = 0
End Sub
Sub List1_Click ()
   txtTempPrinter = PrinterArray(List1.ListIndex + 1)
End Sub
Sub Option1_Click (Index As Integer)
   If Index = 0 Then
      txtTempOrientation = "PORTRAIT"
   Else
      txtTempOrientation = "LANDSCAPE"
   End If
End Sub
Sub txtTempOrientation_Change ()
   If txtTempOrientation = "PORTRAIT" Then
      Option1(0) = True
   Else
      Option1(1) = True
   End If
End Sub
Sub txtTempPrinter_Change ()
   Dim I%
   For I = 0 To List1.ListCount - 1
      If List1.List(I) = txtTempPrinter Then
         List1.ListIndex = I
      End If
   Next I
End Sub